perm filename TYPESE.SAI[P,JRA]1 blob
sn#298091 filedate 1977-07-27 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 DEFINE CRLF="('15&'12)", !="comment", proc="simple procedure",
C00008 00003 ! procedure typeset(string s)
C00010 00004 define
C00012 00005 proc stuff(integer x) ! x is tty code, jam it in punch buffer
C00013 00006 procedure film_adv(string s) ! s is string rep of point, half-point advance
C00014 00007 procedure line_meas(string s) ! s is tring rep of pica-point width
C00015 00008 proc indentto(integer n) ! manufacture the "bellIL" sequence
C00016 00009 ! proc setfont(integer n)
C00018 00010 ! proc burp( reference integer array p: integer sup1, sub1, text)
C00020 00011 ! procedure setline ! end of line routine. must check for sup/sub hacking
C00022 00012 ! proc linesp(integer n)
C00023 00013 begin "MAIN PROGRAM"
C00025 00014 add crap for page number location (suck for "<FF>")
C00026 00015 read page 1
C00029 00016 page←pagebeg
C00032 ENDMK
C⊗;
DEFINE CRLF="('15&'12)", !="comment", proc="simple procedure",
crlfff="('15&'12&'14)",
crlfffsp="('15&'12&'14&'40)",
INCHAN=1,PTPCHAN=2;
BEGIN "TYPESET"
require"⊂⊃⊂⊃"delimiters;
string s,s1,slead,swidth;
integer lead,lmar,xline,width,i,eof,pagebeg,pagend;
integer page,tolb,torb,tospeq;
define debug(x)=⊂⊃;
! define debug(x)=⊂outstr(x)⊃;
PRELOAD_with
"a1","a5","b1","a1","c6","b1","a3","a1","a3","b6","a3","a4","a4","b5","a3","a3";
string array font[0:16];
PRELOAD_with
"10","10","10","06","10","10","10","06","10","24","10","08","10","10","10","10";
string array fontsize[0:16]; ! an extra slot for vip specials;
PRELOAD_with
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
'15, 0, 0, 0, 0, 0, 0, 0,
0, '07, 0, 0, -'07, '23, '61, -'21,
'43, -'43, 0, 0, -'31, -'23, -'71, 0,
-'55, -'73, -'47, -'03, -'25, -'41, -'53, -'17,
-'15, -'61, '65, -'65, 0, 0, 0, '55,
0, '06, '62, '34, '22, '02, '32, '64,
'50, '14, '26, '36, '44, '70, '30, '60,
'54, '56, '24, '12, '40, '16, '74, '46,
'72, '52, '42, 0, 0, 0, 0, 0,
'21, -'06, -'62, -'34, -'22, -'02, -'32, -'64,
-'50, -'14, -'26, -'36, -'44, -'70, -'30, -'60,
-'54, -'56, -'24, -'12, -'40, -'16, -'74, -'46,
-'72, -'52, -'42, 0, 0, 0, 0, 0;
integer array chrtbl[0:128]; ! table encoding p-45 vip codes;
! table is indexed by ascii code;
! if entry is positive then its an uppercase character;
! if negative then it's a lower case;
! if entry is zero then hack special( typically greek math strip);
integer page1,
topar, ! break table for parens;
loc, ! index in punch buffer;
supfont,! index of superscript font;
subfont;! for subscripts;
integer array punch_buf[0:1000];
boolean mon, ! `minus on' when is sum-script mode;
sup, ! a superscript is in the line;
sub, ! a subscript appears;
uc; ! upper case flag;
! next variables are used to minimize the crap put on tape;
! removing unnecessary font, point size, and indent changes;
string cur_size; ! current point size;
integer cur_font_no; ! current font number;
integer cur_indent; ! current indentation;
boolean text_set; ! true if current line has text characters (non-bells);
! tty codes (yuk);
define bell='27,
ensp='35,
bnd='10,
ql='33,
elev='04,
shift='66,
unshift='76,
supershift='45;
define flash='15,
noflash='61; ! these are for sumscripts( 8 and 9 in tty code)!;
define bellit=⊂begin
if not uc then stuff(bell)
else begin stuff(unshift);
stuff(bell);
uc←false;
end;
end⊃;
boolean procedure defile(integer chan; string file,ext,pj,pn); begin ! file defaults;
integer nam,ex,ppn; string sppn;
boolean flag;
nam←cvfil(file,ex,ppn); sppn←cvxstr(ppn);
sppn←"["&(if ppn lsh -18 then sppn[1 to 3] else pj)&","&
(if ppn land '777777 then sppn[4 to 6] else pn)&"]";
lookup(chan,(file←cvxstr(nam)&".")&cvxstr(ex)&sppn,flag);
if flag ∧ ex=0 then lookup(chan,file&ext&sppn,flag);
return(flag) ! TRUE if file not found;
end;
! procedure typeset(string s);
forward proc setfont(integer n);
forward proc stuff(integer n);
forward proc typeset(string s);
forward proc special(string s);
proc typeset(string s);
begin "ty" integer s1;
debug(s&crlf);
while s ≠null do
begin "loop"
s1←lop(s);
if chrtbl[s1]>0 then begin
if uc then stuff(chrtbl[s1])
else begin stuff(shift);
stuff(chrtbl[s1]);
uc←true
end
end
else if chrtbl[s1]<0 then begin
if uc then begin stuff(unshift);
stuff(-chrtbl[s1]);
uc←false
end
else stuff(-chrtbl[s1])
end
else special(s1);
end "loop";
end "ty";
define
grkss(n)=⊂begin
stuff(supershift);
stuff(n);
stuff(unshift);
uc←false;
end⊃,
grkuc(n)=⊂begin
if uc then stuff(n)
else begin stuff(shift);
stuff(n);
uc←true;
end;
end⊃,
grklc(n)=⊂begin
if not uc then stuff(n)
else begin stuff(unshift);
stuff(n);
uc←false
end;
end⊃;
proc special(string c); ! hack non-p45 character;
begin "sp"
integer n;
n←cur_font_no;
setfont(16);
if c="≤" then grkss('47)
else if c="<" then grkss('07) ! $;
else if c="=" then grklc('25) ! "4";
else if c="≥" then grkss('03) ! "3";
else if c=">" then grkss('73) ! "1";
else if c="{" then grkuc('25) ! "4";
else if c="}" then grkuc('41) ! "5";
else if c="≡" then grkss('15) ! "8";
else if c="+" then grklc('73) ! "1";
else if c="[" then grkuc('47) ! "2";
else if c="]" then grkuc('03) ! "3";
else if c="∞" then grklc('07) ! "$";
else if c="""" then grklc('55) ! "0";
else grkuc('56); ! "q";
setfont(n)
end "sp";
proc stuff(integer x); ! x is tty code, jam it in punch buffer;
begin
debug("stuff"&cvos(x)&crlf);
punch_buf[loc]←x;
loc←loc+1;
end;
procedure film_adv(string s); ! s is string rep of point, half-point advance;
begin
bellit;
typeset("f"&s);
end;
procedure line_meas(string s); ! s is tring rep of pica-point width;
begin
bellit;
typeset("l"&s);
end;
proc indentto(integer n); ! manufacture the "bellIL" sequence;
! this should be optimized to kill the film advance;
begin "IN"
if n≠cur_indent then begin "chngind"
integer pt;
string s;
setformat(-4,0);
pt←(n-370.)/2.8;
s←cvs((pt DIV 12)*100+(pt MOD 12));
if text_set then begin
stuff(ql);
bellit;
typeset("m"&slead&",");
end;
bellit;
typeset("il"&s);
cur_indent←n
end "chngind"
end "IN";
! proc setfont(integer n);
! crap to handle superscript and subscripts using flash-noflash hack.
when a sumscript is first recognized in line building,
(at font change) the bell sequence is made but with -1 or -2
at tthe flash position, the NEXT font change is recognized also
and a flash sequence is built with -3. at the end of the line
"setline" recognizes that sumscripts have been seen and "burp"s
the appropriate vversions of the line with correct leading
and appropriate substitutions of 8 and 9 for -1, -2, and -3;
define supon=-1,
subon=-2,
texton=-3;
proc setfont(integer n);
begin "SF"
if fontsize[n]≠cur_size then begin
bellit;
typeset("p"&(cur_size←fontsize[n]))
end;
if n≠cur_font_no then begin "curfnt"
bellit;
typeset(font[n]);
if n=supfont then begin
bellit;
stuff(supon);
sup←mon←true;
end
else if n=subfont then begin
bellit;
stuff(subon);
sub←mon←true;
end
else if mon then begin
bellit;
stuff(texton);
mon←false
end;
cur_font_no←n;
end "curfnt";
end "SF";
! proc burp( reference integer array p: integer sup1, sub1, text);
! burp will dump line using flash/no flash crap;
define punch(x)=⊂wordout(ptpchan,x)⊃;
! ***********;
! define punch(x)=⊂outstr(cvos(x)&crlf)⊃;
proc burp( reference integer array p; integer sup1, sub1, text);
begin "b" integer i;
if sup or sub then begin punch(bell);
punch(text)
end;
for i←0 step 1 until loc-1 do
begin "loop"
if p[i]=supon then punch(sup1)
else if p[i]=subon then punch(sub1)
else if p[i]=texton then punch(text)
else punch(p[i]);
end "loop";
punch(elev)
end "b";
! procedure setline; ! end of line routine. must check for sup/sub hacking;
! setline dumps line to punch, it will check sum scripts;
procedure setline; ! end of line routine. must check for sup/sub hacking;
begin "SL"
if sup then begin
bellit;
typeset("m060,");! should compute this on basis of font size;
burp(punch_buf,
flash,
noflash,
noflash);
bellit;
typeset("m060,"); ! should compute this on basis of font size!;
end;
burp(punch_buf,
noflash,
noflash,
flash);
if sub then begin
bellit;
typeset("m090,"); ! should compute this on basis of font size!;
burp(punch_buf,
noflash,
flash,
noflash);
bellit;
loc←0;
typeset("m030,"); ! should compute this on basis of font size!;
end
else loc←0;
sub←sup←false;
text_set←false;
end "SL";
! proc linesp(integer n);
! linesp figures the leading to give non-standard interline spacing;
proc linesp(integer n);
begin "LS"
integer m;
m←abs((xline-n)/1.4);
if m≠0 then begin
string s,s1;
setformat(-3,0);
s←cvs(m MOD 2);
s1←lop(s);
bellit;
typeset("m"&cvs((m DIV 2)*10+(m MOD 2))&(if xline>n then ","else "."));
! geezus, is that ugly!!!;
end;
end "LS";
begin "MAIN PROGRAM"
setbreak(topar←getbreak, "()", null, "INS");
setbreak(tospeq←getbreak, " =", null, "INS");
while true do
begin "IN"
outstr("name.ext (n:m)? (n≥2; always uses page 1)
");
open (inchan,"DSK",0,2,0,200,0,eof);
open (ptpchan, "PTP", '10,0,2,0,0,0);
! initialize some crap;
uc ← false;
loc←0;
cur_size←null;
cur_font_no←-1;
cur_indent←-1;
text_set←false;
while true do
begin "file"
string file;
outstr("*");
S← inchwl;
file ←scan(s,topar,i);
s1←cvxstr(call(0,"dskppn"));
if defile(inchan,file,"XGP",s1[1 to 3],s1[4 to 6])
then outstr("FILE NOT FOUND: "&file&crlf)
else done;
end "file";
comment add crap for page number location (suck for "<FF>");
pagebeg←2;
pagend←7000;
comment read page 1;
BEGIN "PAGE1"
setbreak(page1←getbreak,"/<>=#",crlfff,"INS");
s1←input(inchan,page1); ! flush leading cr-lf and "/";
if length(s1)≠0
then begin
outstr(cvs(length(s1))&" not proper file format"&crlf);done
end;
s1←input(inchan,page1); ! snarf "lmar=";
lmar←cvd(input(inchan,page1)); ! save left margin setting;
s1←input(inchan,page1); ! snarf "xline=";
xline←cvd(input(inchan,page1)); ! save leading;
while true do
begin "FONTS"
integer f;
string name,s3,s4,f1;
if equ(input(inchan,page1), "CR") ! scan to"#" to get to font number;
then done;
f←cvd(f1 ← input(inchan,page1));! get font number;
name ← input(inchan,page1); ! get sail font name;
if font[f]=null then begin "ask font"
outstr("font "&f1&" is "&name&crlf);
outstr("give VIP position and point size (a-c&1-6&(1-99))
*");
s3←inchwl;
s4←scan(s3,topar,i);
font[f]←s4;
s4←scan(s3,topar,i);
fontsize[f]←s4;
end "ask font";
if equ(name,"SUB") then subfont←f
else if equ(name,"SUP") then supfont←f;
end "FONTS";
font[16]←"a3"; ! vip position for greek math;
fontsize[16]←"10"; ! point size;
outstr("linelength in picas and points (aaoo)?"&crlf&"*");
width ← cvd(swidth←inchwl);
outstr("standard leading (points and half-points (ooh)?"&crlf&"*");
lead ← cvd(slead←inchwl);
END "PAGE1";
page←pagebeg;
input(inchan,page1); ! snarf "<";
input(inchan,page1); ! snarf "LF>";
input(inchan,page1); ! snarf "<";
input(inchan,page1); ! snarf "FF>";
film_adv(slead); ! punch film advance;
line_meas(swidth); ! punch line page width;
setbreak(tolb←getbreak,"<",crlfffsp,"INS");
setbreak(torb←getbreak,">",crlfff,"INS");
while page ≤pagend and not eof do
BEGIN "SET TEXT"
while not eof do
BEGIN "SET PAGE"
s←input(inchan,tolb);
if length(s)≠0 then begin
typeset(s);
text_set←true;
end;
s←input(inchan,torb);
debug(" "&s&crlf);
if equ(s,"SP") then stuff(ensp)
else if equ(s,"CR") then setline
else if equ(s,"LF") then continue
else if equ(s,"LB")then typeset("<")
else if equ(s,"RB")then typeset(">")
else if equ(s,"FF") then begin
page←page+1;
stuff(QL);
stuff(QL);
stuff(QL);
stuff(QL);
stuff(QL);
done end
else begin "BIGcommand"
string s1;
integer br;
s1←scan(s,tospeq,br);
if length(s)=0 then begin outstr("FOO on "&s1&crlf);continue end;
if equ(s1,"COLUMN") then indentto(cvd(s))
else if equ(s1,"FONT") then setfont(cvd(s))
else if equ(s1,"LINESPACE") then linesp(cvd(s))
else if equ(s1,"COL") then stuff(bnd)
else outstr("unrecognized command: "&s1&crlf);
end "BIGcommand";
end "SET PAGE";
end "SET TEXT";
bellit;
typeset("s");
setline
end "IN";
end "MAIN PROGRAM";
END "TYPESET"